home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Prog / D-G / FORTRAN Goodies / WindowTrix.txt < prev   
Encoding:
Text File  |  1990-11-19  |  4.5 KB  |  186 lines  |  [TEXT/MPS ]
  1. !!MP inlines.f
  2. c    This example shows How To 
  3. c        
  4. c        • save the output window to a datafile
  5. c
  6. c        • count the number of selected (highlighted) characters
  7. c
  8. c        • display the selected (highlighted) characters
  9. c
  10. c    Example provided for owners of Language Systems FORTRAN
  11. c    © 1990 Language Systems Corp.
  12. c
  13.     
  14. C    There are two changes you need to make to MPW:Interfaces:FIncludes:Textedit.f.
  15. C    Move the definitions for Chars, CharsPtr, and CharsHandle in front of the
  16. C    definition for TERec.  In the structure definition for TERec, change hText from
  17. C    Record /Handle/ hText to Record/ CharsHandle/ hText.
  18.  
  19.     program OutputWindowTricks
  20.     implicit none
  21.     
  22.     write(*,*)
  23.     write(*,*) 'This program illustrates the Following Output Window Tricks'
  24.     write(*,*)
  25.     write(*,*) '    • How to save the output window to a datafile'
  26.     write(*,*)
  27.     write(*,*) '    • How to count the number of selected (highlighted) characters'
  28.     write(*,*)
  29.     write(*,*) '    • How to display the selected (highlighted) characters'
  30.     write(*,*)
  31.     
  32.     Call ADDMENUITEM('Tricks','Save Data File',Saveit)
  33.     Call ADDMENUITEM('Tricks','Display Selection',DisplaySelection)
  34.     Call ADDMENUITEM('Tricks','Count Characters in Selection',DisplayCharCount)
  35.     
  36.     call DOMENU('Edit','Select All')
  37.     call DOMENU('Tricks','Count Characters in Selection')
  38.     end
  39.  
  40. c ***************************************************************************    
  41. c
  42. c         Saveit -
  43. c            This subroutine illustrates how to save the contents
  44. c            of the output window to a file.
  45. c
  46.     subroutine Saveit
  47.     implicit none
  48.     include 'textedit.f'
  49.     
  50.     record /TEHandle/ wintext
  51.     Record /CharsHandle/ mytexth
  52.     Character*32000 mytext
  53.     Integer*4 OUTPUTTE, L, LL
  54.     external OUTPUTTE
  55.  
  56. c         set up to access the window text
  57.  
  58.     wintext.TEH = OUTPUTTE()
  59.     mytexth = wintext.TEH^.TEP^.hText
  60.  
  61. c         lock the handle so that it doesn't move
  62.  
  63.     Call HLock(mytexth)
  64.  
  65. c        use a local variable to access each character
  66. c        and print them to a file
  67.  
  68.     mytext = mytexth.CHH^.CHP^.chs
  69.     LL = wintext.TEH^.TEP^.teLength
  70.     open(1,file=*'Save output window to file',status = 'new')
  71.     write(1,'($A)') (mytext(L:L),L=1,LL)
  72.     close(1)
  73.  
  74.     call HUnlock(mytexth)
  75.     return
  76.     
  77.     end
  78. c
  79. c How to speed up SaveIt
  80. c            
  81. c    The characters that are stored in the TEHandle are formatted.
  82. c    Because of this, the toolbox call FSWRITE can be used
  83. c    instead of the FORTRAN write.
  84. c
  85. c    To change the program to use an FSWRITE do the following:
  86. c            
  87. c         • add these declarations
  88. c
  89. c            integer*2 refnum
  90. c            integer*4 JFREFNUM
  91. c            external  JFREFNUM
  92. c
  93. c         • remove the line
  94. c
  95. c            mytext = mytexth.CHH^.CHP^.chs
  96. c
  97. c         • replace the line
  98. c
  99. c            write(1,'($A)') (mytext(L:L),L=1,LL)
  100. c
  101. c         with
  102. c
  103. c            refnum = JFREFNUM(int4(1))
  104. c            if (FSWrite(refnum,%ref(LL),mytexth.CHH^.CHP^) <> 0) call ALERTBOX('Write error')
  105. c
  106.  
  107. c ***************************************************************************    
  108. c
  109. c        Function ReturnSelection
  110. c            This function returns the characters that are 
  111. c            selected (highlighted) in the output window.
  112. c            The selection could be up to 32K in length.
  113. c
  114.     character*(*) function ReturnSelection()
  115.     implicit none
  116.     include 'textedit.f'
  117.     
  118.     record /TEHandle/ wintext
  119.     Record /CharsHandle/ mytexth
  120.     Integer*4 OUTPUTTE
  121.     external OUTPUTTE
  122.     pointer /character*1/ chptr
  123.  
  124. c         set up to access the window text
  125.  
  126.     wintext.TEH = OUTPUTTE()
  127.     mytexth = wintext.TEH^.TEP^.hText
  128.  
  129. c        lock the handle so that it doesn't move
  130.  
  131.     Call HLock(mytexth)
  132.  
  133. c        use a local pointer to access the selected/highlighted characters
  134.  
  135.     chptr = wintext.TEH^.TEP^.hText.CHH^.CHP
  136.     ReturnSelection = chptr^(wintext.TEH^.TEP^.selStart+1:wintext.TEH^.TEP^.selEnd)
  137.  
  138.     call HUnlock(mytexth)
  139.     return
  140.     end
  141.  
  142. c ***************************************************************************    
  143. c
  144. c        Function CountSelChars
  145. c            This function returns the number of characters that are
  146. c            selected (highlighted) in the output window.
  147. c
  148.     integer*4 function CountSelChars()
  149.     implicit none
  150.     include 'textedit.f'
  151.     
  152.     record /TEHandle/ wintext
  153.     Integer*4 OUTPUTTE
  154.     external OUTPUTTE
  155.  
  156.     wintext.TEH = OUTPUTTE()
  157.     Call HLock(wintext)
  158.     CountSelChars = wintext.TEH^.TEP^.selEnd - wintext.TEH^.TEP^.selStart
  159.     call HUnlock(wintext)
  160.     return
  161.     end
  162.  
  163. c ***************************************************************************    
  164.     
  165.     subroutine DisplayCharCount
  166.     implicit none
  167.     
  168.     character*20 numChars
  169.     integer*4      CountSelChars
  170.     
  171.     write(numChars,'(i)') CountSelChars()
  172.     call ALERTBOX('There were '//trim(numChars)//' Characters Selected')
  173.     end
  174.     
  175. c ***************************************************************************    
  176. !!stack=32767
  177.  
  178.     subroutine DisplaySelection
  179.     implicit none
  180.     
  181.     character*32000 ReturnSelection
  182.  
  183.     call ALERTBOX(trim(ReturnSelection()))
  184.     end
  185.     
  186.